home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tvdmx.exe / TVDMX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-16  |  58.9 KB  |  2,362 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    tvDMX     --data editing project (ver 1.5)    }
  5. {                            }
  6. {    Copyright (c) 1992  Randolph Beck        }
  7. {                P.O. Box  56-0487        }
  8. {                Orlando, FL 32856        }
  9. {                CIS:  72361,753        }
  10. {                            }
  11. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  12.  
  13. Unit tvDMX;
  14.  
  15. {$B-,D-,O+,R-,X+,V- }
  16.  
  17. interface
  18.  
  19. uses  Objects, Drivers, Views, App, RSet, DmxGizma;
  20.  
  21. type
  22.     PDmxLink     = ^TDmxLink;
  23.     PDmxLabels     = ^TDmxLabels;
  24.     PDmxScroller = ^TDmxScroller;
  25.     PDmxRecInd     = ^TDmxRecInd;
  26.     PDmxEditor     = ^TDmxEditor;
  27.  
  28.  
  29.     TDmxLink    =  OBJECT (TView)
  30.     Link  : PDmxScroller;
  31.       constructor Init (Bounds : TRect);
  32.       constructor Load (var S : TStream);
  33.       function  GetPalette : PPalette;  VIRTUAL;
  34.       procedure Store (var S : TStream);
  35.       procedure Insert (AOwner : PGroup);
  36.     end;
  37.  
  38.  
  39.     TDmxLabels    =  OBJECT (TDmxLink)
  40.     Len   : integer;
  41.     Data  : PCharArray;
  42.       constructor Init (DataStr : pstring; var Bounds : TRect);
  43.       constructor InitInsert (AOwner : PGroup;  DataStr : pstring);
  44.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  45.       procedure Draw;  VIRTUAL;
  46.       procedure DrawRuler (Upper, AtLimit : boolean);
  47.       constructor Load (var S : TStream);
  48.       procedure Store (var S : TStream);
  49.     end;
  50.  
  51.  
  52.     TDmxScroller =  OBJECT (TScroller)
  53.     Labels        : PDmxLink;
  54.     WorkingData    : pointer;
  55.     DataBlockSize    : longint;
  56.     CurrentRecord    : integer;
  57.     CurrentField    : pDMXfieldrec;
  58.     DMXfield1    : pDMXfieldrec;
  59.     LeftField    : pDMXfieldrec;
  60.     TotalFields    : integer;
  61.     RecordSize    : integer;
  62.     Locked        : boolean;
  63.     InitValid    : boolean;
  64.       constructor Init (ATemplate  : string; var AData; BSize : longint;
  65.         var Bounds : TRect;  ALabels : PView;  AHScrollBar,AVScrollBar : PScrollBar);
  66.       procedure   InitStruct (var ATemplate );  VIRTUAL;
  67.       procedure   InitData (var AData );  VIRTUAL;
  68.       destructor  Done;  VIRTUAL;
  69.       constructor Load (var S : TStream);
  70.       procedure Store (var S : TStream);
  71.       procedure LoadData (var S : TStream);  VIRTUAL;
  72.       procedure LoadStruct (var S : TStream);  VIRTUAL;
  73.       procedure StoreData (var S : TStream);  VIRTUAL;
  74.       procedure StoreStruct (var S : TStream);  VIRTUAL;
  75.       procedure DoneStruct;  VIRTUAL;
  76.       procedure DoneData;  VIRTUAL;
  77.       function  Valid (Command : word)  : boolean;  VIRTUAL;
  78.       procedure ChangeBounds (var Bounds : TRect);  VIRTUAL;
  79.       function  GetPalette  : PPalette;  VIRTUAL;
  80.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  81.       procedure WrongKeypressed (var Event : TEvent);  VIRTUAL;
  82.       procedure SetState (AState : word;  Enable : boolean);  VIRTUAL;
  83.       function  DataAt (RecNum : integer)  : pointer;  VIRTUAL;
  84.       procedure DrawRecord (Y : integer;  var DataRecord );
  85.       procedure Draw;  VIRTUAL;
  86.       private
  87.     InBuffer    : boolean;
  88.     DDelta,DSize    : TPoint;
  89.     vwidth        : integer;
  90.     end;
  91.  
  92.  
  93.     TDmxRecInd   =  OBJECT (TDmxLink)
  94.       constructor Init (Bounds : TRect;  Len : integer);
  95.       constructor InitInsert (AOwner : PGroup; Len : integer);
  96.       procedure SetState (AState : word; Enable : boolean);  VIRTUAL;
  97.       procedure Draw;  VIRTUAL;
  98.     end;
  99.  
  100.  
  101.     TDmxEditor   =  OBJECT (TDmxScroller)
  102.     RecInd        : PDmxLink;
  103.     FieldData    : pointer;
  104.     RecordData    : pointer;
  105.     CurPos        : integer;
  106.     Vidis        : boolean;
  107.     DoubleValid    : boolean;
  108.     FirstKey    : boolean;
  109.     RedrawRecord    : boolean;
  110.     FieldAltered    : boolean;
  111.     RecordAltered    : boolean;
  112.     JustAltered    : boolean;
  113.     DataAltered    : boolean;
  114.     FieldSelected    : boolean;
  115.     RecordSelected    : boolean;
  116.       constructor Init (ATemplate  : string;  var AData; BSize : longint;
  117.             var Bounds : TRect;  ALabels,ARecInd  : PDmxLink;
  118.             AHScrollBar,AVScrollBar : PScrollBar);
  119.       constructor Load (var S : TStream);
  120.       destructor  Done;  VIRTUAL;
  121.       procedure Store (var S : TStream);
  122.       procedure SetState (AState : word;  Enable : boolean);  VIRTUAL;
  123.       procedure ChangeBounds (var Bounds : TRect);  VIRTUAL;
  124.       procedure ChangeMade;
  125.       procedure SetUpField;  VIRTUAL;
  126.       procedure EvaluateField;  VIRTUAL;
  127.       procedure SetUpRecord;  VIRTUAL;
  128.       procedure EvaluateRecord;  VIRTUAL;
  129.       procedure Draw;  VIRTUAL;
  130.       procedure DrawField (var Field : pDMXfieldrec);
  131.       procedure ZeroizeRecord;  VIRTUAL;
  132.       procedure ZeroizeField (Whole : boolean; Field : pDMXfieldrec);  VIRTUAL;
  133.       procedure ProcessMouse   (var Event : TEvent);
  134.       procedure ProcessCommand (var Command : word;  XY  : TPoint);
  135.       procedure ProcessEnter (var Event : TEvent);  VIRTUAL;
  136.       procedure ProcessKey (var Event : TEvent);
  137.       procedure GotoPos (AFieldNum,ARecNum : integer);
  138.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  139.       private
  140.     FirstPos    : integer;
  141.     ShowFmt        : showset;
  142.     end;
  143.  
  144.  
  145. const
  146.     RDmxLabels   :  TStreamRec = (
  147.     ObjType:  cmDMX + 1;
  148.     VmtLink:  ofs (TypeOf (TDmxLabels)^);
  149.     Load:     @TDmxLabels.Load;
  150.     Store:    @TDmxLabels.Store
  151.       );
  152.  
  153.     RDmxScroller :  TStreamRec = (
  154.     ObjType:  cmDMX + 2;
  155.     VmtLink:  ofs (TypeOf (TDmxScroller)^);
  156.     Load:     @TDmxScroller.Load;
  157.     Store:    @TDmxScroller.Store
  158.       );
  159.  
  160.     RDmxRecInd   :  TStreamRec = (
  161.     ObjType:  cmDMX + 3;
  162.     VmtLink:  ofs (TypeOf (TDmxRecInd)^);
  163.     Load:     @TDmxRecInd.Load;
  164.     Store:    @TDmxRecInd.Store
  165.       );
  166.  
  167.     RDmxEditor   :  TStreamRec = (
  168.     ObjType:  cmDMX + 4;
  169.     VmtLink:  ofs (TypeOf (TDmxEditor)^);
  170.     Load:     @TDmxEditor.Load;
  171.     Store:    @TDmxEditor.Store
  172.       );
  173.  
  174.  
  175.   procedure RegisterDMX;
  176.  
  177.  
  178. implementation
  179.  
  180.  
  181.   { ══ TDmxLink ══════════════════════════════════════════════════════════ }
  182.  
  183.  
  184. constructor TDmxLink.Init (Bounds : TRect);
  185. begin
  186.   TView.Init (Bounds);
  187.   GrowMode  := gfGrowLoY or gfGrowHiY;
  188.   EventMask := evMessage;
  189. end;
  190.  
  191.  
  192. constructor TDmxLink.Load (var S : TStream);
  193. begin
  194.   TView.Load (S);
  195.   GetPeerViewPtr (S, Link);
  196. end;
  197.  
  198.  
  199. function  TDmxLink.GetPalette : PPalette;
  200. begin
  201.   GetPalette := @cDMX
  202. end;
  203.  
  204.  
  205. procedure TDmxLink.Store (var S : TStream);
  206. begin
  207.   TView.Store (S);
  208.   PutPeerViewPtr (S, Link);
  209. end;
  210.  
  211.  
  212. procedure TDmxLink.Insert (AOwner : PGroup);
  213. begin
  214.   If (AOwner <> nil) then AOwner^.Insert (@Self);
  215. end;
  216.  
  217.  
  218.   { ══ TDmxLabels ════════════════════════════════════════════════════════ }
  219.  
  220.  
  221. constructor TDmxLabels.Init (DataStr : pstring;  var Bounds : TRect);
  222. begin
  223.   TDmxLink.Init (Bounds);
  224.   Move (DataStr, Data, sizeof (Data));
  225.   Len := length (DataStr^);
  226.   Inc (PtrRec (Data).Ofs);
  227.   GrowMode := gfGrowHiX;
  228. end;
  229.  
  230.  
  231. constructor TDmxLabels.InitInsert (AOwner : PGroup;  DataStr : pstring);
  232. var  R : TRect;
  233. begin
  234.   AOwner^.GetExtent (R);
  235.   Inc (R.A.Y);
  236.   R.B.Y  := R.A.Y + 2;
  237.   R.Grow (-1, 0);
  238.   TDmxLink.Init (R);
  239.   Move (DataStr, Data, sizeof (Data));
  240.   Len := length (DataStr^);
  241.   Inc (PtrRec (Data).Ofs);
  242.   GrowMode := gfGrowHiX;
  243.   Insert (AOwner);
  244. end;
  245.  
  246.  
  247. procedure TDmxLabels.HandleEvent (var Event : TEvent);
  248. var  dX,dY  : integer;
  249. begin
  250.   TDmxLink.HandleEvent (Event);
  251.   With Event do
  252.     If (What = evBroadcast) and (Command = cmDMX_FixSize) and (Size.X > Len) then
  253.       begin
  254.       dX := (Owner^.Size.X - Size.X) + Len;
  255.       dY :=  Owner^.Size.Y;
  256.       Owner^.GrowTo (dX, dY);
  257.       end;
  258. end;
  259.  
  260.  
  261. procedure TDmxLabels.Draw;
  262. var  A  : string;
  263. begin
  264.   Move (Data^ [Link^.Delta.X], A [1], Size.X);
  265.   If (Link^.Delta.X + Size.X > Len) then
  266.     fillchar (A [succ (Len - Link^.Delta.X)], (Size.X + Link^.Delta.X - Len), ' ');
  267.   A [0] := chr (lo (Size.X));
  268.   WriteStr (0, 0, A, 1);
  269.   If (Size.Y > 1) then DrawRuler (TRUE, FALSE);
  270. end;
  271.  
  272.  
  273. procedure TDmxLabels.DrawRuler (Upper, AtLimit : boolean);
  274. const
  275.   LtArr        =  17;
  276.   RtArr        =  16;
  277.   Markers    : string [10] = '─═┬╤╥╦┴╧╨╩';
  278. var
  279.   Color        : word;
  280.   i,X,width    : integer;
  281.   Mk        : integer;
  282.   frontcut    : integer;
  283.   fieldrec    : pDMXfieldrec;
  284.   A        : string;
  285.   B        : TDrawBuffer;
  286. begin
  287.   If (longint (Size) = 0) or (Link = nil) or (Link^.DMXfield1 = nil) then Exit;
  288.   fieldrec  := Link^.LeftField;
  289.   If (fieldrec = nil) or (fieldrec^.screentab > Link^.Delta.X) then
  290.     fieldrec := Link^.DMXfield1;
  291.   While (fieldrec^.Next^.screentab <= Link^.Delta.X) and
  292.     (fieldrec^.Next <> nil)
  293.    do
  294.     fieldrec := fieldrec^.Next;
  295.   frontcut  := Link^.Delta.X - fieldrec^.screentab;
  296.   If frontcut < 0 then frontcut := 0;
  297.   X      := 0;
  298.   Color  := GetColor (5);
  299.   If AtLimit then Mk := 2 else Mk := 1;
  300.   MoveChar (B, Markers [Mk], Color, Size.X);
  301.   Inc (Mk, 2);
  302.   If not Upper then Inc (Mk, 4);
  303.   While (X < Size.X) do
  304.     begin
  305.     With fieldrec^ do
  306.       begin
  307.       If (access and accHidden = 0) then
  308.     begin
  309.     If access and accDelimiter <> 0 then
  310.       begin
  311.       If fieldrec^.typecode = '║' then char (B [X]) := Markers [Mk + 2]
  312.        else If fieldrec^.typecode = '│' then char (B [X]) := Markers [Mk];
  313.       Inc (X);
  314.       end
  315.      else
  316.       begin
  317.       X := X + length (template^) - frontcut;
  318.       end;
  319.     frontcut := 0;
  320.     end;
  321.       end;
  322.     fieldrec := fieldrec^.Next;
  323.     If (fieldrec = nil) and (Size.X > X) then X := Size.X;
  324.     end;
  325.   If Upper then i := pred (Size.Y) else i := 0;
  326.   WriteLine (0, i, Size.X, succ (i), B);
  327. end;
  328.  
  329.  
  330. constructor TDmxLabels.Load (var S : TStream);
  331. begin
  332.   TDmxLink.Load (S);
  333.   S.Read (Len, sizeof (Len));
  334.   If Len > 0 then
  335.     begin
  336.     GetMem (Data, Len);
  337.     S.Read (Data^, Len);
  338.     end
  339.    else
  340.     Data := nil;
  341. end;
  342.  
  343.  
  344. procedure TDmxLabels.Store (var S : TStream);
  345. begin
  346.   TDmxLink.Store (S);
  347.   S.Write (Len, sizeof (Len));
  348.   If Len > 0 then S.Write (Data^, Len);
  349. end;
  350.  
  351.  
  352.   { ══ TDmxScroller ══════════════════════════════════════════════════════ }
  353.  
  354.  
  355. constructor TDmxScroller.Init (ATemplate : string; var AData;
  356.                    BSize : longint; var Bounds : TRect;
  357.                    ALabels : PView;
  358.                    AHScrollBar,AVScrollBar : PScrollBar);
  359. begin
  360.   TScroller.Init (Bounds, AHScrollBar, AVScrollBar);
  361.   InitValid     := TRUE;
  362.   DataBlockSize := BSize;
  363.   InitStruct (ATemplate);
  364.   InitData (AData);
  365.   If RecordSize > 0 then SetLimit (vwidth, DataBlockSize div RecordSize);
  366.   LeftField := DMXfield1;
  367.   GrowMode  := gfGrowHiX or gfGrowHiY;
  368.   Labels    := PDmxLink (ALabels);
  369.   If Labels <> nil then Labels^.Link := @Self;
  370. end;
  371.  
  372.  
  373. destructor TDmxScroller.Done;
  374. begin
  375.   TScroller.Done;
  376.   DoneData;
  377.   DoneStruct;
  378. end;
  379.  
  380.  
  381. constructor TDmxScroller.Load (var S : TStream);
  382. begin
  383.   TScroller.Load (S);
  384.   InitValid := TRUE;
  385.   GetPeerViewPtr (S, Labels);
  386.   S.Read (TotalFields, sizeof (TotalFields));
  387.   S.Read (RecordSize,  sizeof (RecordSize));
  388.   S.Read (CurrentRecord, sizeof (CurrentRecord));
  389.   S.Read (DataBlockSize, sizeof (DataBlockSize));
  390.   InBuffer  := FALSE;
  391.   LoadData (S);
  392.   LoadStruct (S);
  393. end;
  394.  
  395.  
  396. procedure TDmxScroller.Store (var S : TStream);
  397. begin
  398.   TScroller.Store (S);
  399.   PutPeerViewPtr (S, Labels);
  400.   S.Write (TotalFields, sizeof (TotalFields));
  401.   S.Write (RecordSize,  sizeof (RecordSize));
  402.   S.Write (CurrentRecord, sizeof (CurrentRecord));
  403.   S.Write (DataBlockSize, sizeof (DataBlockSize));
  404.   StoreData (S);
  405.   StoreStruct (S);
  406. end;
  407.  
  408.  
  409. procedure TDmxScroller.LoadData (var S : TStream);
  410. begin
  411.   Abstract;
  412. end;
  413.  
  414.  
  415. procedure TDmxScroller.LoadStruct (var S : TStream);
  416. var n     : integer;
  417.     P,Px : pDMXfieldrec;
  418. begin
  419.   S.Read (vwidth, sizeof (vwidth));
  420.   DMXfield1 := nil;
  421.   S.Read (n, sizeof (n));
  422.   Px := nil;
  423.   While (n > 0) do
  424.     begin
  425.     GetMem (P, sizeof (P^));
  426.     S.Read (P^, sizeof (P^));
  427.     If (P^.template <> nil) then P^.template := S.ReadStr;
  428.     If DMXfield1 = nil then DMXfield1 := P;
  429.     If Px <> nil then Px^.Next := P;
  430.     P^.Prev := Px;
  431.     P^.Next := nil;
  432.     Px      := P;
  433.     Dec (n);
  434.     end;
  435.   LeftField := DMXfield1;
  436. end;
  437.  
  438.  
  439. procedure TDmxScroller.StoreData (var S : TStream);
  440. begin
  441.   Abstract;
  442. end;
  443.  
  444.  
  445. procedure TDmxScroller.StoreStruct (var S : TStream);
  446. var  n : integer;
  447.      P : pDMXfieldrec;
  448. begin
  449.   S.Write (vwidth, sizeof (vwidth));
  450.   n  := 0;
  451.   P  := DMXfield1;
  452.   While (P <> nil) do
  453.     begin
  454.     Inc (n);
  455.     P := P^.Next;
  456.     end;
  457.   S.Write (n, sizeof (n));
  458.   P := DMXfield1;
  459.   While (P <> nil) do
  460.     begin
  461.     S.Write (P^, sizeof (P^));
  462.     If (P^.template <> nil) then S.WriteStr (P^.template);
  463.     P := P^.Next;
  464.     end;
  465. end;
  466.  
  467.  
  468. procedure TDmxScroller.InitStruct (var ATemplate );
  469. var
  470.   i,j        :  integer;
  471.   SameFieldNum    :  boolean;
  472.   WasSameNum    :  boolean;
  473.   AllZeroes    :  boolean;
  474.   C        :  char;
  475.   DoDecimal    :  integer;
  476.   dataformat    :  pstring;
  477.   Rex,X        :  pDMXfieldrec;
  478.   templx    :  string;
  479.  
  480.   procedure NewRecord;
  481.   var i,j : integer;
  482.       A   : pstring;
  483.   begin
  484.     If not InitValid then Exit;
  485.     With Rex^ do
  486.       begin
  487.       If DoDecimal > 0 then Rex^.decimals := pred (DoDecimal);
  488.       DoDecimal := 0;
  489.       If (fieldsize = 0) then
  490.     access := access or accSkip
  491.        else
  492.     begin
  493.     If SameFieldNum then
  494.       fieldnum := succ (TotalFields)
  495.      else
  496.       If (access and accHidden = 0) or WasSameNum then
  497.         begin
  498.         Inc (TotalFields);
  499.         fieldnum := TotalFields;
  500.         end;
  501.     datatab    := RecordSize;
  502.     RecordSize := RecordSize + fieldsize;
  503.     end;
  504.       screentab  := vwidth;
  505.       If (typecode = fldBOOLEAN) and (truelen = 0) then showzeroes := FALSE;
  506.       If access and accHidden = 0 then vwidth := vwidth + length (templx);
  507.       If length (templx) > 0 then
  508.     begin
  509.     If (MaxAvail > length (templx)) then
  510.       template  := NewStr (templx)
  511.      else
  512.       InitValid := FALSE;
  513.     templx := '';
  514.     end
  515.        else
  516.     begin
  517.     If (typecode <> #0) and (access and accHidden = 0) then Inc (vwidth);
  518.     end;
  519.       end;
  520.     If (MaxAvail > sizeof (Rex^)) then
  521.       begin
  522.       New (Rex^.Next);
  523.       X   := Rex;
  524.       Rex := Rex^.Next;
  525.       fillchar (Rex^, sizeof (Rex^), 0);
  526.       Rex^.Prev := X;
  527.       Rex^.showzeroes := AllZeroes;
  528.       end
  529.      else
  530.       InitValid := FALSE;
  531.     WasSameNum := FALSE;
  532.   end;
  533.  
  534. begin
  535.   SameFieldNum := FALSE;
  536.   WasSameNum   := FALSE;
  537.   AllZeroes    := FALSE;
  538.   dataformat   := @ATemplate;
  539.   If dataformat = nil then Exit;
  540.   templx    := '';
  541.   DoDecimal :=  0;
  542.   New (Rex);
  543.   fillchar (Rex^, sizeof (Rex^), 0);
  544.   Rex^.showzeroes := AllZeroes;
  545.   If DMXfield1 = nil then
  546.     DMXfield1 := Rex
  547.    else
  548.     begin
  549.     X := DMXfield1;
  550.     While X^.Next <> nil do X := X^.Next;
  551.     X^.Next := Rex;
  552.     Rex^.Prev := X;
  553.     end;
  554.   i := 1;
  555.   While (i <= length (dataformat^)) do
  556.     begin
  557.     C := upcase (dataformat^ [i]);
  558.     Case C of
  559.       fldSTR, fldSTRNUM:
  560.     With Rex^ do
  561.       begin
  562.       templx   := templx + #0;
  563.       typecode := dataformat^ [i];
  564.       Inc (truelen);
  565.       If fieldsize > 0 then
  566.         Inc (fieldsize)
  567.        else
  568.         begin
  569.         fieldsize :=  2;
  570.         fillvalue := ' ';
  571.         end;
  572.       end;
  573.       fldCHAR, fldCHARVAL, fldCHARNUM:
  574.     With Rex^ do
  575.       begin
  576.       templx    := templx + #0;
  577.       typecode  := dataformat^ [i];
  578.       Inc (truelen);
  579.       Inc (fieldsize);
  580.       If fieldsize > 0 then fillvalue := ' ';
  581.       If DoDecimal > 0 then Inc (DoDecimal);
  582.       end;
  583.       fldBYTE, fldSHORTINT, fldBOOLEAN:
  584.     With Rex^ do
  585.       begin
  586.       templx    := templx + #0;
  587.       If upcase (C) <> fldSHORTINT then C := upcase (C);
  588.       typecode  := dataformat^ [i];
  589.       Inc (truelen);
  590.       fieldsize := sizeof (BYTE);
  591.       If fieldsize > 0 then fillvalue := #0;
  592.       end;
  593.       ^X :
  594.     With Rex^ do
  595.       begin
  596.       typecode  := fldBOOLEAN;
  597.       truelen   := 0;
  598.       fieldsize := sizeof (BOOLEAN);
  599.       If fieldsize > 0 then fillvalue := #0;
  600.       end;
  601.       fldZEROMOD:  { 'Z' }
  602.     With Rex^ do
  603.       begin
  604.       If (typecode = #0) or (typecode = fldCHARVAL) then Inc (fieldsize);
  605.       templx := templx + #1;
  606.       Inc (truelen);
  607.       end;
  608.       fldWORD, fldINTEGER:
  609.     With Rex^ do
  610.       begin
  611.       templx    := templx + #0;
  612.       typecode  := dataformat^ [i];
  613.       Inc (truelen);
  614.       fieldsize := sizeof (INTEGER);
  615.       If fieldsize > 0 then fillvalue := #0;
  616.       end;
  617.       fldLONGINT:
  618.     With Rex^ do
  619.       begin
  620.       templx    := templx + #0;
  621.       typecode  := dataformat^ [i];
  622.       Inc (truelen);
  623.       fieldsize := sizeof (LONGINT);
  624.       If fieldsize > 0 then fillvalue := #0;
  625.       end;
  626.       fldHEXVALUE:
  627.     With Rex^ do
  628.       begin
  629.       templx    := templx + #0;
  630.       typecode  := dataformat^ [i];
  631.       Inc (truelen);
  632.       fieldsize := succ (truelen) shr 1;
  633.       If fieldsize > 0 then fillvalue := #0;
  634.       end;
  635.       fldREALNUM:
  636.     With Rex^ do
  637.       begin
  638.       templx    := templx + #0;
  639.       typecode  := dataformat^ [i];
  640.       Inc (truelen);
  641.       fieldsize := sizeof (TREALNUM);
  642.       fillvalue := #0;
  643.       If DoDecimal > 0 then Inc (DoDecimal);
  644.       end;
  645.       ')','.':
  646.     With Rex^ do
  647.       begin
  648.       templx := templx + C;
  649.       If (upcase (Rex^.typecode) = fldCHARVAL) then
  650.         begin
  651.         If (C = ')') then Inc (truelen);
  652.         Inc (fieldsize);
  653.         end;
  654.       If (C = '.') then
  655.         begin
  656.         If (upcase (typecode) = fldREALNUM) or
  657.            (upcase (typecode) = fldCHARVAL) then
  658.           DoDecimal := 1;
  659.         end
  660.        else
  661.         parenthesis := TRUE;
  662.       end;
  663.       '~':
  664.     begin
  665.     Inc (i);
  666.     While (dataformat^[i] <> '~') and (i <= length (dataformat^)) do
  667.       begin
  668.       C := dataformat^ [i];
  669.       If C = #0 then C := ' ';
  670.       If C = #1 then C := #2;
  671.       templx := templx + C;
  672.       Inc (i);
  673.       end;
  674.     end;
  675.       #0,'\','|','│','║':
  676.     begin
  677.     If (templx <> '') then NewRecord;
  678.     If C <> #0 then
  679.       begin
  680.       If C = '|' then C := '│' else If C = '\' then C := ' ';
  681.       Rex^.access    := Rex^.access or accDelimiter;
  682.       Rex^.typecode  := C;
  683.       NewRecord;
  684.       end;
  685.     end;
  686.       ^A:
  687.     begin
  688.     AllZeroes    := not AllZeroes;
  689.     Rex^.showzeroes  := AllZeroes;
  690.     end;
  691.       ^D:
  692.     begin
  693.     If (templx <> '') then NewRecord;
  694.     Inc (i);
  695.     C := dataformat^ [i];
  696.     Rex^.access    := Rex^.access or accDelimiter;
  697.     Rex^.typecode  := C;
  698.     NewRecord;
  699.     end;
  700.       ^F:   begin
  701.         SameFieldNum := not SameFieldNum;
  702.         WasSameNum   := not SameFieldNum;
  703.         end;
  704.       ^H:   With Rex^ do access := access or accHidden;
  705.       ^P:   With Rex^ do
  706.           begin
  707.           Inc (i);
  708.           RecordSize := RecordSize + shortint (dataformat^ [i]);
  709.           end;
  710.       ^R:   With Rex^ do access := access or accReadOnly;
  711.       ^S:   With Rex^ do access := access or accSkip;
  712.       ^U:   With Rex^ do
  713.           begin
  714.           Inc (i);
  715.           upperlimit := byte (dataformat^ [i]);
  716.           end;
  717.       ^V:   With Rex^ do
  718.           begin
  719.           Inc (i);
  720.           fillvalue := dataformat^ [i];
  721.           end;
  722.       ^Z:   Rex^.showzeroes := TRUE;
  723.      else
  724.     begin
  725.     templx := templx + dataformat^ [i];
  726.     end;
  727.       end;  { case of C }
  728.     Inc (i);
  729.     end;
  730.   SameFieldNum := FALSE;
  731.   If templx <> '' then NewRecord;
  732.   Dispose (Rex);
  733.   X^.Next := nil;
  734.   If DMXfield1 <> nil then DMXfield1^.Prev := X;
  735. end;
  736.  
  737.  
  738. procedure TDmxScroller.DoneStruct;
  739. var  P : pDMXfieldrec;
  740. begin
  741.   While DMXfield1 <> nil do
  742.     begin
  743.     P := DMXfield1^.Next;
  744.     If DMXfield1^.template <> nil then DisposeStr (DMXfield1^.template);
  745.     Dispose (DMXfield1);
  746.     DMXfield1 := P;
  747.     end;
  748.   LeftField    := nil;
  749.   TotalFields  :=  0;
  750.   RecordSize   :=  0;
  751.   vwidth       :=  0;
  752. end;
  753.  
  754.  
  755. procedure TDmxScroller.InitData (var AData );
  756. begin
  757.   WorkingData := @AData;
  758. end;
  759.  
  760.  
  761. procedure TDmxScroller.DoneData;
  762. begin
  763. end;
  764.  
  765.  
  766. function  TDmxScroller.Valid (Command : word)  : boolean;
  767. var  V : boolean;
  768. begin
  769.   V := TScroller.Valid (Command);
  770.   If (Command = cmValid) then V := V and InitValid;
  771.   Valid := V;
  772. end;
  773.  
  774.  
  775. procedure TDmxScroller.ChangeBounds (var Bounds : TRect);
  776. begin
  777.   InBuffer := FALSE;
  778.   TScroller.ChangeBounds (Bounds);
  779. end;
  780.  
  781.  
  782. function  TDmxScroller.GetPalette : PPalette;
  783. begin
  784.   GetPalette := @cDMX
  785. end;
  786.  
  787.  
  788. procedure TDmxScroller.HandleEvent (var Event : TEvent);
  789. var  WasHere : boolean;
  790. begin
  791.   TScroller.HandleEvent (Event);
  792.   With Event do
  793.     If (What and evMessage <> 0) then
  794.       begin
  795.       WasHere := TRUE;
  796.       If (((Command = cmDMX_DrawData) and (WorkingData = InfoPtr)) or
  797.       ((Command = cmDMX_Draw) and
  798.       (InfoPtr <> @Self) and
  799.       ((PDmxScroller (InfoPtr)^.WorkingData = WorkingData) or (What = evCommand))))
  800.       then DrawView
  801.       else
  802.       If not Locked and (((Command = cmDMX_LockData) and (WorkingData = InfoPtr)) or
  803.     ((Command = cmDMX_Lock) and
  804.     ((PDmxScroller (InfoPtr)^.WorkingData = WorkingData) or (What = evCommand))))
  805.       then Locked := TRUE
  806.       else
  807.       If Locked and (((Command = cmDMX_UnlockData) and (WorkingData = InfoPtr)) or
  808.     ((Command = cmDMX_Unlock) and
  809.     ((PDmxScroller (InfoPtr)^.WorkingData = WorkingData) or (What = evCommand))))
  810.       then Locked := FALSE
  811.       else
  812.       If (Command = cmDMX_RollCall) then
  813.     begin
  814.     If (InfoPtr <> @Self) and (InfoPtr <> nil) then
  815.       Message (InfoPtr, evCommand, cmDMX_Ack, @Self);
  816.     end
  817.       else
  818.         WasHere := FALSE;
  819.       If WasHere and (What = evCommand) then ClearEvent (Event);
  820.       end;
  821. end;
  822.  
  823.  
  824. procedure TDmxScroller.WrongKeypressed (var Event : TEvent);
  825. begin
  826.   Message (Application, evCommand, cmDMX_WrongKey, @Self);
  827. end;
  828.  
  829.  
  830. procedure TDmxScroller.SetState (AState : word; Enable : boolean);
  831. var  L : longint;
  832. begin
  833.   If (AState and sfFocused <> 0) then
  834.     begin
  835.     If Enable then
  836.       begin
  837.       If (RecordSize > 0) then
  838.     begin
  839.     L := DataBlockSize - (DataBlockSize mod RecordSize);
  840.     If (L <> RecordSize * Limit.Y) then
  841.       SetLimit (vwidth, DataBlockSize div RecordSize);
  842.     end;
  843.       If (Application <> nil) then
  844.     TScroller.SetState (sfCursorIns, Application^.GetState (sfCursorIns));
  845.       end
  846.      else
  847.       begin
  848.       If (Application <> nil) then
  849.     Application^.SetState (sfCursorIns, GetState (sfCursorIns));
  850.       end;
  851.     end;
  852.   TScroller.SetState (AState, Enable);
  853. end;
  854.  
  855.  
  856. function  TDmxScroller.DataAt (RecNum : integer) : pointer;
  857. begin
  858.   DataAt := ptr (PtrRec (WorkingData).Seg, PtrRec (WorkingData).Ofs + RecNum * RecordSize);
  859. end;
  860.  
  861.  
  862. procedure TDmxScroller.DrawRecord (Y : integer;  var DataRecord );
  863. var Color        : word;
  864.     ColorA, ColorB    : word;
  865.     I,X, width        : integer;
  866.     frontcut        : integer;
  867.     fieldrec        : pDMXfieldrec;
  868.     A            : string;
  869.     B            : TDrawBuffer;
  870. begin
  871.   fieldrec := LeftField;
  872.   frontcut := Delta.X - fieldrec^.screentab;
  873.   X       := 0;
  874.   ColorA   := GetColor (1);
  875.   ColorB   := GetColor (5);
  876.   While (X < Size.X) do
  877.     begin
  878.     With fieldrec^ do
  879.       begin
  880.       If (access and accHidden = 0) then
  881.     begin
  882.     If access and accDelimiter <> 0 then
  883.       begin
  884.       A    := typecode;
  885.       Color := ColorB;
  886.       end
  887.      else
  888.       begin
  889.       If @DataRecord = nil then
  890.         begin
  891.         A [0] := fieldrec^.template^ [0];
  892.         fillchar (A [1], length (fieldrec^.template^), ' ');
  893.         end
  894.        else
  895.         A    := FieldString (fieldrec, [], DataRecord);
  896.       If frontcut > 0 then Delete (A, 1, frontcut);
  897.       Color := ColorA;
  898.       end;
  899.     frontcut := 0;
  900.     MoveStr (B [X], A, Color);
  901.     X  := X + length (A);
  902.     end;
  903.       end;
  904.     fieldrec := fieldrec^.Next;
  905.     If (fieldrec = nil) and (Size.X > X) then
  906.       begin
  907.       MoveChar (B [X], ' ', ColorA, Size.X - X);
  908.       X  := Size.X;
  909.       end;
  910.     end;
  911.   WriteLine (0, Y, Size.X, 1, B);
  912. end;
  913.  
  914.  
  915. procedure TDmxScroller.Draw;
  916. var
  917.   i,rows,Y,owid  :  integer;
  918.   A   :  string;
  919.   B   :  TDrawBuffer;
  920.   Buf : ^TDrawBuffer;
  921. begin
  922.   HideCursor;
  923.   rows := Size.Y;
  924.   Y    := -1;
  925.   LeftField  := DMXfield1;
  926.   While (LeftField^.Next^.screentab <= Delta.X) and
  927.     (LeftField^.Next <> nil)
  928.    do
  929.     LeftField := LeftField^.Next;
  930.   If (Labels <> nil) and (DDelta.X <> Delta.X) then Labels^.DrawView;
  931.   If (Owner^.Buffer <> nil) and InBuffer then
  932.     begin
  933.     If (Delta.X = DDelta.X) and (abs (Delta.Y - DDelta.Y) = 1) and
  934.        (Size.Y > 1) and (longint (Size) = longint (DSize))
  935.      then
  936.       begin
  937.       owid := Owner^.Size.X shl 1;
  938.       longint (Buf) := longint (Owner^.Buffer) + ((Origin.Y * owid) + (Origin.X shl 1));
  939.       If (Delta.Y > DDelta.Y) then  { Down }
  940.     begin
  941.     For i := 0 to (Size.Y - 2) do
  942.       begin
  943.       ptrrec (Buf).ofs := ptrrec (Buf).ofs + owid;
  944.       WriteBuf (0, i, Size.X, 1, Buf^);
  945.       end;
  946.     Y := Size.Y - 2;
  947.     end
  948.        else  { Up }
  949.     begin
  950.     ptrrec (Buf).ofs := ptrrec (Buf).ofs + ((Size.Y - 2) * owid);
  951.     For i := (Size.Y - 1) downto 1 do
  952.       begin
  953.       WriteBuf (0, i, Size.X, 1, Buf^);
  954.       ptrrec (Buf).ofs := ptrrec (Buf).ofs - owid;
  955.       end;
  956.     Rows := 1;
  957.     end;
  958.       end;
  959.     end;
  960.   If rows > 0 then
  961.     begin
  962.     While (Y < pred (rows)) do
  963.       begin
  964.       Inc (Y);
  965.       If Y + Delta.Y < Limit.Y then
  966.     DrawRecord (Y, DataAt (Y + Delta.Y)^)
  967.        else
  968.     DrawRecord (Y, Mem [0:0]);
  969.       end;
  970.     end;
  971.   DDelta   := Delta;
  972.   DSize    := Size;
  973.   InBuffer := (Owner^.Buffer <> nil);
  974. end;
  975.  
  976.  
  977.   { ══ TDmxRecInd ════════════════════════════════════════════════════════ }
  978.  
  979.  
  980. constructor TDmxRecInd.Init (Bounds : TRect;  Len : integer);
  981. begin
  982.   TDmxLink.Init (Bounds);
  983.   GrowMode  := gfGrowLoY or gfGrowHiY;
  984.   EventMask := evMessage;
  985. end;
  986.  
  987.  
  988. constructor TDmxRecInd.InitInsert (AOwner : PGroup; Len : integer);
  989. var  R : TRect;
  990. begin
  991.   AOwner^.GetExtent (R);
  992.   Inc (R.A.X);
  993.   R.A.Y  := pred (R.B.Y);
  994.   R.Grow (-1, 0);
  995.   If (R.B.X - R.A.X > Len) then R.B.X := R.A.X + Len;
  996.   R.B.Y  := succ (R.A.Y);
  997.   TDmxLink.Init (R);
  998.   GrowMode  := gfGrowLoY or gfGrowHiY;
  999.   EventMask := evMessage;
  1000.   Insert (AOwner);
  1001. end;
  1002.  
  1003.  
  1004. procedure TDmxRecInd.SetState (AState : word;  Enable : boolean);
  1005. begin
  1006.   If (AState and (sfActive or sfDragging) <> 0) then
  1007.     TDmxLink.SetState (sfVisible, Enable xor (AState and sfDragging <> 0));
  1008.   TDmxLink.SetState (AState, Enable);
  1009. end;
  1010.  
  1011.  
  1012. procedure TDmxRecInd.Draw;
  1013. var  A  : string;
  1014.      B  : TDrawBuffer;
  1015.      C  : word;
  1016. begin
  1017.   C := GetColor (6);
  1018.   MoveChar (B, '═', C, Size.X);
  1019.   Str (succ (Link^.CurrentRecord):1, A);
  1020.   If length (A) > Size.X then
  1021.     MoveChar (B, showOVERFLOW, C, Size.X)
  1022.    else
  1023.     begin
  1024.     If length (A) < Size.X then A := A + ' ';
  1025.     If length (A) < Size.X then A := ' ' + A;
  1026.     MoveStr (B [succ ((Size.X) - length (A)) shr 1], A, C);
  1027.     end;
  1028.   WriteBuf (0, 0, Size.X, 1, B);
  1029. end;
  1030.  
  1031.  
  1032.   { ══ TDmxEditor ═══════════════════════════════════════════════════════ }
  1033.  
  1034.  
  1035. constructor TDmxEditor.Init (ATemplate  : string;  var AData;  BSize : longint;
  1036.                  var Bounds : TRect;  ALabels,ARecInd  : PDmxLink;
  1037.                  AHScrollBar,AVScrollBar : PScrollBar);
  1038. var  inbounds  : TRect;
  1039. begin
  1040.   TDmxScroller.Init (ATemplate, AData, BSize, Bounds, ALabels, AHScrollBar, AVScrollBar);
  1041.   CurrentField := DMXfield1;
  1042.   While (CurrentField <> nil) and
  1043.     (CurrentField^.access and (accHidden or accSkip or accDelimiter) <> 0)
  1044.    do
  1045.     CurrentField := CurrentField^.Next;
  1046.   CurrentRecord  := 0;
  1047.   RecInd := ARecInd;
  1048.   If RecInd <> nil then
  1049.     begin
  1050.     RecInd^.Link := @Self;
  1051.     If (HScrollBar <> nil) then
  1052.       begin
  1053.       HScrollBar^.GetBounds (inbounds);
  1054.       inbounds.A.X := inbounds.A.X + RecInd^.Size.X + 1;
  1055.       HScrollBar^.Locate (inbounds);
  1056.       end;
  1057.     end;
  1058. end;
  1059.  
  1060.  
  1061. constructor TDmxEditor.Load (var S : TStream);
  1062. var  i,n : integer;
  1063. begin
  1064.   TDmxScroller.Load (S);
  1065.   GetPeerViewPtr (S, RecInd);
  1066.   CurrentField := DMXfield1;
  1067.   S.Read (n, sizeof (n));
  1068.   i := 0;
  1069.   While (i <> n) and (CurrentField <> nil) do
  1070.     begin
  1071.     CurrentField := CurrentField^.Next;
  1072.     Inc (i);
  1073.     end;
  1074.   If CurrentField = nil then CurrentField := DMXfield1;
  1075.   S.Read (Locked, sizeof (Locked));
  1076.   FieldAltered    :=  FALSE;
  1077.   If CurrentField <> nil then
  1078.     begin
  1079.     SetUpRecord;
  1080.     SetUpField;
  1081.     end;
  1082. end;
  1083.  
  1084.  
  1085. destructor TDmxEditor.Done;
  1086. begin
  1087.   If (CurrentField <> nil) then
  1088.     begin
  1089.     If FieldSelected  then EvaluateField;
  1090.     If RecordSelected then EvaluateRecord;
  1091.     end;
  1092.   TDmxScroller.Done;
  1093. end;
  1094.  
  1095.  
  1096. procedure TDmxEditor.Store (var S : TStream);
  1097. var n  : integer;
  1098.     df : pDMXfieldrec;
  1099. begin
  1100.   If CurrentField <> nil then
  1101.     begin
  1102.     EvaluateField;
  1103.     EvaluateRecord;
  1104.     end;
  1105.   TDmxScroller.Store (S);
  1106.   PutPeerViewPtr (S, RecInd);
  1107.   df := DMXfield1;
  1108.   n  := 0;
  1109.   While (df <> CurrentField) do
  1110.     begin
  1111.     df := df^.Next;
  1112.     Inc (n);
  1113.     end;
  1114.   S.Write (n, sizeof (n));
  1115.   S.Write (Locked, sizeof (Locked));
  1116. end;
  1117.  
  1118.  
  1119. procedure TDmxEditor.SetState (AState : word; Enable : boolean);
  1120.  
  1121.     procedure HoldState (On : boolean);
  1122.     begin
  1123.       If On then
  1124.     begin
  1125.     RedrawRecord := TRUE;
  1126.     If (DataBlockSize > 0) and (RecordSize > 0) and
  1127.        (DataBlockSize div RecordSize < CurrentRecord)
  1128.      then CurrentRecord := DataBlockSize div RecordSize;
  1129.     SetUpRecord;
  1130.     SetUpField;
  1131.     TDmxScroller.SetState (AState, Enable);
  1132.     end
  1133.        else
  1134.     begin
  1135.     TDmxScroller.SetState (AState, Enable);
  1136.     EvaluateField;
  1137.     EvaluateRecord;
  1138.     If JustAltered then
  1139.       begin
  1140.       If DeskTop <> nil then Message (DeskTop, evBroadcast, cmDMX_Draw, @Self);
  1141.       JustAltered := FALSE;
  1142.       end;
  1143.     end;
  1144.     end;
  1145.  
  1146. begin
  1147.   If not Vidis and (CurrentField <> nil) and (AState and sfFocused <> 0) then
  1148.     HoldState (Enable)
  1149.   else
  1150.   If (AState and sfDragging <> 0) then
  1151.     HoldState (not Enable)
  1152.   else
  1153.   TDmxScroller.SetState (AState, Enable);
  1154. end;
  1155.  
  1156.  
  1157. procedure TDmxEditor.ChangeBounds (var Bounds : TRect);
  1158. var  i,j       : integer;
  1159.      ReScroll  : boolean;
  1160.      xy    : TPoint;
  1161. begin
  1162.   TDmxScroller.ChangeBounds (Bounds);
  1163.   ReScroll := FALSE;
  1164.   If CurrentField <> nil then With CurrentField^ do
  1165.     If (template <> nil) then
  1166.       begin
  1167.       xy := Delta;
  1168.       If (Size.X - (screentab - Delta.X) < 0) or
  1169.      (Size.X <= length (template^)) then
  1170.     begin
  1171.     xy.X  := screentab + length (template^) - Size.X;
  1172.     If (Size.X <= length (template^)) then xy.X := screentab else If (xy.X > 0) then Inc (xy.X);
  1173.     ReScroll := TRUE;
  1174.     end
  1175.        else
  1176.     If (Size.X - (screentab + length (template^) - Delta.X) < 0) then
  1177.       begin
  1178.       xy.X  := screentab + length (template^) - Size.X;
  1179.       ReScroll := TRUE;
  1180.       end;
  1181.       end;
  1182.     If (Size.Y - (CurrentRecord - Delta.Y) <= 0) then
  1183.       begin
  1184.       xy.Y := succ (CurrentRecord - Size.Y);
  1185.       If xy.Y < 0 then xy.Y := 0;
  1186.       ReScroll := TRUE;
  1187.       end;
  1188.   If ReScroll then ScrollTo (xy.X, xy.Y);
  1189. end;
  1190.  
  1191.  
  1192. procedure TDmxEditor.ChangeMade;
  1193. begin
  1194.   FieldAltered  := TRUE;
  1195.   RecordAltered := TRUE;
  1196.   JustAltered   := TRUE;
  1197.   DataAltered   := TRUE;
  1198. end;
  1199.  
  1200.  
  1201. procedure TDmxEditor.SetUpField;
  1202. begin
  1203.   FieldSelected := TRUE;
  1204.   FieldAltered  := FALSE;
  1205.   FieldData := ptr (seg (RecordData^), ofs (RecordData^) + CurrentField^.datatab);
  1206.   FirstKey  := TRUE;
  1207.   ShowFmt   := [showanyway];
  1208.   CurPos    :=  0;
  1209.   FirstPos  :=  0;
  1210.   With CurrentField^ do
  1211.     If upcase (typecode) in [fldCHARVAL, fldBYTE, fldSHORTINT, fldWORD,
  1212.                  fldINTEGER, fldLONGINT, fldREALNUM, fldHEXVALUE]
  1213.      then
  1214.       begin
  1215.       CurPos := pred (truelen - decimals);
  1216.       If CurPos < 0 then CurPos := 0;
  1217.       end;
  1218.   If GetState (sfVisible) then DrawField (CurrentField);
  1219.   If (RecInd <> nil) then RecInd^.DrawView;
  1220. end;
  1221.  
  1222.  
  1223. procedure TDmxEditor.EvaluateField;
  1224. begin
  1225.   ShowFmt   := ShowFmt + [showregular] - [shownegative] - [showanyway];
  1226.   DrawField (CurrentField);
  1227.   ShowFmt   := ShowFmt - [showregular];
  1228.   If FieldAltered then Message (Owner, evBroadcast, cmDMX_FieldAltered, @Self);
  1229.   FieldSelected := FALSE;
  1230. end;
  1231.  
  1232.  
  1233. procedure TDmxEditor.SetUpRecord;
  1234. begin
  1235.   RecordData     := DataAt (CurrentRecord);
  1236.   RecordAltered  := FALSE;
  1237.   RecordSelected := TRUE;
  1238. end;
  1239.  
  1240.  
  1241. procedure TDmxEditor.EvaluateRecord;
  1242. begin
  1243.   RecordSelected := FALSE;
  1244. end;
  1245.  
  1246.  
  1247. procedure TDmxEditor.Draw;
  1248. begin
  1249.   TDmxScroller.Draw;
  1250.   If FieldSelected and (showanyway in ShowFmt) then DrawField (CurrentField);
  1251. end;
  1252.  
  1253.  
  1254. procedure TDmxEditor.DrawField (var Field : pDMXfieldrec);
  1255. const
  1256.   rpoint = #16;
  1257.   lpoint = #17;
  1258. var
  1259.   Color  : byte;
  1260.   i,j,k  : integer;
  1261.   x1,x2  : integer;
  1262.   Len    : integer;
  1263.   front  : boolean;
  1264.   hyde   : boolean;
  1265.   S      : string;
  1266.   B      : TDrawBuffer;
  1267. begin
  1268.   If (CurrentField = nil) then Exit;
  1269.   If RedrawRecord then
  1270.     begin
  1271.     DrawRecord (CurrentRecord - Delta.Y, RecordData^);
  1272.     RedrawRecord := FALSE;
  1273.     end;
  1274.   hyde := TRUE;
  1275.   With Field^ do If (template <> nil) and (length (template^) > 0) then
  1276.     begin
  1277.     If (access and (accHidden or accDelimiter) = 0) then
  1278.       begin
  1279.       S  := FieldString (Field, ShowFmt, RecordData^);
  1280.       x1 := screentab - Delta.X;
  1281.       x2 := x1 + length (S);
  1282.       If x1 < 0 then
  1283.     begin
  1284.     x1 := 0;
  1285.     front := FALSE;
  1286.     end
  1287.        else
  1288.     front := TRUE;
  1289.       If x2 > Size.X then x2 := Size.X;
  1290.       Len  := x2 - x1;
  1291.       If Len > 0 then
  1292.     begin
  1293.     If not (showregular in ShowFmt) then
  1294.       begin
  1295.       j := 0;
  1296.       k := 0;
  1297.       If fieldsize > 0 then
  1298.         For i := 1 to length (S) do
  1299.           If (ord (template^ [i]) and $FE = 0) then
  1300.         begin
  1301.         If (CurPos >= j) then k := i;
  1302.         Inc (j);
  1303.         end;
  1304.       If k > 0 then
  1305.         begin
  1306.         If CurPos = 0 then FirstPos := 0;
  1307.         If (CurPos = truelen) and (length (S) > Len) then
  1308.           FirstPos := length (S) - Len;
  1309.         If length (S) <= Len then
  1310.           begin
  1311.           FirstPos := 0;
  1312.           end
  1313.          else
  1314.           begin
  1315.           If pred (k) <= FirstPos then
  1316.         begin
  1317.         FirstPos := pred (k);
  1318.         If FirstPos > 0 then
  1319.           begin
  1320.           Delete (S, 1,FirstPos);
  1321.           k := k - FirstPos;
  1322.           end;
  1323.         end
  1324.            else
  1325.         begin
  1326.         j := 0;
  1327.         If FirstPos > 0 then
  1328.           begin
  1329.           Delete (S, 1,FirstPos);
  1330.           k := k - FirstPos;
  1331.           j := FirstPos;
  1332.           end;
  1333.         If length (S) > Len then
  1334.           begin
  1335.           If k > Len then
  1336.             begin
  1337.             i := k - Len;
  1338.             FirstPos := i + j;
  1339.             If i > 0 then Delete (S, 1, i);
  1340.             k := k - i;
  1341.             end;
  1342.           end;
  1343.         end;
  1344.           end;
  1345.         If Len > 3 then
  1346.           begin
  1347.           If (k = Len) and (length (S) > Len) then
  1348.         begin
  1349.         Delete (S, 1,1);
  1350.         Inc (FirstPos);
  1351.         Dec (k);
  1352.         end;
  1353.           If (FirstPos > 0) then
  1354.         begin
  1355.         If k > 1 then S [1] := lpoint
  1356.          else
  1357.           begin
  1358.           System.Insert (lpoint, S, 1);
  1359.           Inc (k);
  1360.           Inc (FirstPos);
  1361.           end;
  1362.         end;
  1363.           If length (S) > Len then S [Len] := rpoint;
  1364.           end;
  1365.         SetCursor (pred (k) + x1, CurrentRecord - Delta.Y);
  1366.         end;
  1367.       If Locked or (access and accReadOnly <> 0) then
  1368.         begin
  1369.         Color := GetColor (3);
  1370.         end
  1371.        else
  1372.         begin
  1373.         If (k > 0) and not GetState (sfDragging) then hyde := FALSE;
  1374.         Color := GetColor (2);
  1375.         end;
  1376.       end
  1377.      else
  1378.       begin
  1379.       If (length (S) > Len) and not front then Delete (S, 1, length (S) - Len);
  1380.       Color := GetColor (1);
  1381.       end;
  1382.     MoveStr (B, S, Color);
  1383.     i := CurrentRecord - Delta.Y;
  1384.     WriteLine (x1, i, Len, 1, B);
  1385.     end;
  1386.       end;
  1387.     end;
  1388.   If hyde then HideCursor else ShowCursor;
  1389. end;
  1390.  
  1391.  
  1392. procedure TDmxEditor.ZeroizeRecord;
  1393. var  field : pDMXfieldrec;
  1394. begin
  1395.   field := DMXfield1;
  1396.   If (RecordData <> nil) then
  1397.     While (field <> nil) do
  1398.       begin
  1399.       ZeroizeField (FALSE, field);
  1400.       field := field^.Next;
  1401.       end;
  1402. end;
  1403.  
  1404.  
  1405. procedure TDmxEditor.ZeroizeField (Whole : boolean;  Field : pDMXfieldrec);
  1406. var  FData : pointer;
  1407.      fn    : byte;
  1408. begin
  1409.   If (RecordData = nil) or (Field = nil) or Locked then Exit;
  1410.   fn := Field^.fieldnum;
  1411.   If Whole and (fn <> 0) then Field := DMXfield1;
  1412.   While Field <> nil do
  1413.     begin
  1414.     If Field^.fieldnum = fn then
  1415.       begin
  1416.       With Field^ do
  1417.     If (access and accReadOnly = 0) and (fieldsize > 0) then
  1418.       begin
  1419.       FData := ptr (seg (RecordData^), ofs (RecordData^) + datatab);
  1420.       fillchar (FData^, fieldsize, fillvalue);
  1421.       Case upcase (typecode) of
  1422.         fldSTR,
  1423.         fldSTRNUM:   pstring (FData)^ [0] := #0;
  1424.         fldCHARVAL:
  1425.           begin
  1426.           fillchar (FData^, fieldsize, '0');
  1427.           If fieldsize - decimals > 2 then fillchar (FData^, fieldsize - decimals - 2, ' ');
  1428.           If decimals > 0 then pstring (FData)^ [fieldsize - decimals - 1] := '.';
  1429.           end;
  1430.         end;
  1431.       ChangeMade;
  1432.       end;
  1433.       end;
  1434.     If Whole and (fn <> 0) then Field := Field^.Next else Field := nil;
  1435.     end;
  1436.   FirstKey    := TRUE;
  1437.   RedrawRecord    := TRUE;
  1438. end;
  1439.  
  1440.  
  1441. procedure TDmxEditor.GotoPos (AFieldNum,ARecNum : integer);
  1442. var RS  : integer;
  1443.     X,Y : integer;
  1444.     F   : pDMXfieldrec;
  1445. begin
  1446.   If RecordSelected then
  1447.     begin
  1448.     If FieldSelected then
  1449.       begin
  1450.       RS := 2;
  1451.       EvaluateField;
  1452.       end
  1453.      else
  1454.       RS := 1;
  1455.     EvaluateRecord;
  1456.     end
  1457.    else
  1458.     RS := 0;
  1459.   CurrentRecord := ARecNum;
  1460.   Y := CurrentRecord - (Size.Y shr 1);
  1461.   If (Y < 0) then Y := 0;
  1462.   F := DMXfield1;
  1463.   While (F^.fieldnum <> AFieldNum) and (F <> nil) do F := F^.Next;
  1464.   If (F = nil) or (AFieldNum = 0) then
  1465.     X := Delta.X
  1466.    else
  1467.     begin
  1468.     X := F^.screentab;
  1469.     CurrentField := F;
  1470.     end;
  1471.   If (X > Limit.X) then X := Limit.X;
  1472.   If (Y > Limit.Y) then Y := Limit.Y;
  1473.   ScrollTo (X, Y);
  1474.   If (RS > 0) then
  1475.     begin
  1476.     SetupRecord;
  1477.     If (RS = 2) then SetupField;
  1478.     end;
  1479. end;
  1480.  
  1481.  
  1482. procedure TDmxEditor.HandleEvent (var Event : TEvent);
  1483. var  XY : TPoint;
  1484.      RS,FS : boolean;
  1485. begin
  1486.   RS := FALSE;
  1487.   FS := FALSE;
  1488.   If not GetState (sfDragging) then
  1489.     begin
  1490.     Case Event.What of
  1491.       evNothing:   begin end;
  1492.       evMouseDown: ProcessMouse (Event);
  1493.       evKeyDown:
  1494.       If (Event.KeyCode <> kbEsc) then
  1495.         begin
  1496.         If (Event.KeyCode = kbEnter) then ProcessEnter (Event);
  1497.         If (Event.What = evKeyDown)  then ProcessKey (Event);
  1498.         end;
  1499.       evCommand:
  1500.       If (Event.Command >= cmDMX_ZeroizeRec) and
  1501.          (Event.Command <= cmDMX_Bottom) then
  1502.         begin
  1503.         ProcessCommand (Event.Command, XY);
  1504.         If (Event.Command = 0) then ClearEvent (Event);
  1505.         end;
  1506.       end;
  1507.     With Event do If (What and evMessage <> 0) then
  1508.       If ((Command = cmDMX_DrawData) and (WorkingData = InfoPtr)) or
  1509.          ((Command = cmDMX_LockData) and (WorkingData = InfoPtr)) or
  1510.          ((Command = cmDMX_UnlockData) and (WorkingData = InfoPtr)) or
  1511.          ((((InfoPtr <> @Self) and (PDmxScroller (InfoPtr)^.WorkingData = WorkingData)) or
  1512.             (What = evCommand)) and
  1513.             ((Command = cmDMX_Draw) or ((Command = cmDMX_Lock) or ((Command = cmDMX_Unlock)))))
  1514.        then
  1515.         begin
  1516.         RS := RecordSelected;
  1517.         If RS then
  1518.           begin
  1519.           FS := FieldSelected;
  1520.           If FS then EvaluateField;
  1521.           EvaluateRecord;
  1522.           end;
  1523.         end;
  1524.     end;
  1525.   If (Event.What <> evNothing) then TDmxScroller.HandleEvent (Event);
  1526.   If RS then
  1527.     begin
  1528.     SetupRecord;
  1529.     If FS then SetupField;
  1530.     end;
  1531. end;
  1532.  
  1533.  
  1534. procedure TDmxEditor.ProcessMouse (var Event : TEvent);
  1535. var
  1536.   i,j        : word;
  1537.   MousePlace    : TPoint;
  1538. begin
  1539.   With Event do
  1540.     If (Event.What = evMouseDown) and GetState (sfFocused) and
  1541.        (MouseInView (Where)) then
  1542.       begin
  1543.       MakeLocal (Where, MousePlace);
  1544.       MousePlace.X := MousePlace.X + Delta.X;
  1545.       MousePlace.Y := MousePlace.Y + Delta.Y;
  1546.       i := cmDMX_goto;
  1547.       ProcessCommand (i, MousePlace);
  1548.       ClearEvent (Event);
  1549.       end;
  1550. end;
  1551.  
  1552.  
  1553. procedure TDmxEditor.ProcessCommand (var Command : word;  XY : TPoint);
  1554. var
  1555.   i,j   : word;
  1556.   xx,yy : integer;
  1557.   DoIt  : integer;
  1558.   F     : pDMXfieldrec;
  1559.   RS,FS : boolean;
  1560.  
  1561.     procedure DoHome;
  1562.     begin
  1563.       F := DMXfield1;
  1564.       If F <> nil then
  1565.     begin
  1566.     While (F^.access and (accHidden or accSkip or accDelimiter) <> 0)
  1567.       and (F^.Next <> nil)
  1568.      do
  1569.       F := F^.Next;
  1570.     CurrentField := F;
  1571.     end;
  1572.       If CurrentField <> nil then With CurrentField^ do
  1573.     begin
  1574.     xx := 0;
  1575.     If (screentab + length (template^) - 1 > Size.X) then xx := screentab;
  1576.     end;
  1577.     end;
  1578.  
  1579. begin
  1580.   If (Command = cmDMX_WrongKey) then Exit;
  1581.   RS   := RecordSelected;
  1582.   FS   := FieldSelected;
  1583.   DoIt :=  0;
  1584.   xx   := Delta.X;
  1585.   yy   := Delta.Y;
  1586.   If (Command >= cmDMX_Enter) and (Command <= cmDMX_Bottom) then
  1587.     begin
  1588.     If FS then EvaluateField;
  1589.     DoIt  :=  1;
  1590.     If (Command > cmDMX_goto) then
  1591.       begin
  1592.       If RS then EvaluateRecord;
  1593.       DoIt  :=  2;
  1594.       end;
  1595.     end;
  1596.   If ReDrawRecord then
  1597.     begin
  1598.     DrawRecord (CurrentRecord - Delta.Y, RecordData^);
  1599.     ReDrawRecord := FALSE;
  1600.     end;
  1601.  
  1602.   Case Command of
  1603.  
  1604.     cmDMX_ZeroizeRec:  ZeroizeRecord;
  1605.  
  1606.     cmDMX_Left:
  1607.     If CurrentField <> DMXfield1 then
  1608.       begin
  1609.       F := CurrentField^.Prev;
  1610.       While (F^.access and (accHidden or accSkip or accDelimiter) <> 0)
  1611.         and (F <> nil)
  1612.        do
  1613.         begin
  1614.         If F = DMXfield1 then F := nil else F := F^.Prev;
  1615.         end;
  1616.       If F <> nil then CurrentField := F;
  1617.       If CurrentField <> nil then With CurrentField^ do
  1618.         begin
  1619.         If (screentab < xx) then
  1620.           begin
  1621.           xx := screentab;
  1622.           If (xx > 0) and (Size.X > length (template^)) then Dec (xx);
  1623.           end;
  1624.         end;
  1625.       end;
  1626.  
  1627.     cmDMX_Right:
  1628.     begin
  1629.     F := CurrentField^.Next;
  1630.     While (F^.access and (accHidden or accSkip or accDelimiter) <> 0)
  1631.       and (F <> nil)
  1632.      do
  1633.       F := F^.Next;
  1634.     If F <> nil then CurrentField := F;
  1635.     If CurrentField <> nil then With CurrentField^ do
  1636.       begin
  1637.       If (screentab + length (template^) - 1 > xx + pred (Size.X)) then
  1638.         begin
  1639.         xx := screentab + length (template^) - Size.X;
  1640.         If (xx < Limit.X) and (Size.X > length (template^)) then Inc (xx);
  1641.         end;
  1642.       end;
  1643.     end;
  1644.  
  1645.     cmDMX_Home:  DoHome;
  1646.  
  1647.     cmDMX_End:
  1648.     begin
  1649.     F := CurrentField;
  1650.     If F <> nil then
  1651.       begin
  1652.       While (F^.Next <> nil) do F := F^.Next;
  1653.       While (F^.access and (accHidden or accSkip or accDelimiter) <> 0)
  1654.         and (F^.Prev <> nil)
  1655.        do
  1656.         F := F^.Prev;
  1657.       CurrentField := F;
  1658.       xx := Limit.X;
  1659.       With CurrentField^ do
  1660.         If (screentab < xx) then
  1661.           begin
  1662.           xx := screentab;
  1663.           If (xx > 0) and (Size.X > length (template^)) then Dec (xx);
  1664.           end;
  1665.       end;
  1666.     end;
  1667.  
  1668.     cmDMX_goto:
  1669.     begin
  1670.     F := CurrentField;
  1671.     DoubleValid := FALSE;
  1672.     If F <> nil then
  1673.       begin
  1674.       While ((F^.access and accHidden <> 0) or (F^.screentab < XY.x))
  1675.          and (F^.Next <> nil)
  1676.          and (F <> nil)
  1677.        do
  1678.         F := F^.Next;
  1679.       If (F <> nil) then
  1680.         begin
  1681.         While ((F^.access and accHidden <> 0) or (F^.screentab > XY.x))
  1682.            and (F <> nil)
  1683.          do
  1684.           F := F^.Prev;
  1685.         If (F <> nil) and
  1686.            (F^.access and (accDelimiter or accSkip) = 0)
  1687.          then
  1688.           begin
  1689.           DoubleValid := TRUE;
  1690.           With F^ do
  1691.         begin
  1692.         If (screentab < xx) then
  1693.           begin
  1694.           xx := screentab;
  1695.           If (xx > 0) and (Size.X > length (template^)) then Dec (xx);
  1696.           end
  1697.          else
  1698.           begin
  1699.           If (screentab + length (template^) - 1 > xx + pred (Size.X)) then
  1700.             begin
  1701.             xx := screentab + length (template^) - Size.X;
  1702.             If (xx < Limit.X) and (Size.X > length (template^)) then Inc (xx);
  1703.             end;
  1704.           end;
  1705.         end;
  1706.           If (CurrentRecord = XY.y) then
  1707.         CurrentField := F
  1708.            else
  1709.         begin
  1710.         If RS then EvaluateRecord;
  1711.         DoIt  :=  2;
  1712.         If ReDrawRecord then
  1713.           begin
  1714.           DrawRecord (CurrentRecord - Delta.Y, RecordData^);
  1715.           ReDrawRecord := FALSE;
  1716.           end;
  1717.         CurrentField  :=  F;
  1718.         CurrentRecord := XY.y;
  1719.         If CurrentRecord >= Limit.Y then CurrentRecord := pred (Limit.Y);
  1720.         end;
  1721.           end;
  1722.         end;
  1723.       end;
  1724.     end;
  1725.  
  1726.     cmDMX_NextRow:
  1727.     begin
  1728.     If succ (CurrentRecord) < Limit.Y then
  1729.       begin
  1730.       Inc (CurrentRecord);
  1731.       If yy + Size.Y <= CurrentRecord then
  1732.         yy := CurrentRecord - Size.Y + 1;
  1733.       If yy < 0 then yy := 0;
  1734.       end;
  1735.     DoHome;
  1736.     end;
  1737.  
  1738.     cmDMX_Up:
  1739.     begin
  1740.     If CurrentRecord > 0 then
  1741.       begin
  1742.       Dec (CurrentRecord);
  1743.       If yy > CurrentRecord then yy := CurrentRecord;
  1744.       end;
  1745.     end;
  1746.  
  1747.     cmDMX_Down:
  1748.     begin
  1749.     If succ (CurrentRecord) < Limit.Y then
  1750.       begin
  1751.       Inc (CurrentRecord);
  1752.       If yy + Size.Y <= CurrentRecord then
  1753.         yy := CurrentRecord - Size.Y + 1;
  1754.       If yy < 0 then yy := 0;
  1755.       end;
  1756.     end;
  1757.  
  1758.     cmDMX_PgUp:
  1759.     begin
  1760.     CurrentRecord := CurrentRecord - Size.Y + 1;
  1761.     If CurrentRecord < 0 then CurrentRecord := 0;
  1762.     yy := yy - Size.Y + 1;
  1763.     If yy < 0 then
  1764.       begin
  1765.       yy := 0;
  1766.       CurrentRecord := 0;
  1767.       end;
  1768.     end;
  1769.  
  1770.     cmDMX_PgDn:
  1771.     begin
  1772.     CurrentRecord := CurrentRecord + Size.Y - 1;
  1773.     If CurrentRecord >= Limit.Y then
  1774.       CurrentRecord := pred (Limit.Y);
  1775.     If CurrentRecord < 0 then CurrentRecord := 0;
  1776.     yy := yy + Size.Y - 1;
  1777.     If yy < 0 then
  1778.       begin
  1779.       yy := 0;
  1780.       CurrentRecord := 0;
  1781.       end;
  1782.     If yy > Limit.Y + Size.Y - 1 then yy := Limit.Y + Size.Y - 1;
  1783.     end;
  1784.  
  1785.     cmDMX_ScreenTop:  CurrentRecord := Delta.Y;
  1786.  
  1787.     cmDMX_ScreenBottom:
  1788.     begin
  1789.     CurrentRecord := Delta.Y + Size.Y - 1;
  1790.     If CurrentRecord > Limit.Y then CurrentRecord := pred (Limit.Y);
  1791.     end;
  1792.  
  1793.     cmDMX_Top:
  1794.     begin
  1795.     CurrentRecord := 0;
  1796.     yy := 0;
  1797.     end;
  1798.  
  1799.     cmDMX_Bottom:
  1800.     begin
  1801.     CurrentRecord := pred (Limit.Y);
  1802.     If CurrentRecord < 0 then CurrentRecord := 0;
  1803.     yy := pred (Limit.Y);
  1804.     end;
  1805.  
  1806.    else begin  end;
  1807.  
  1808.     end;
  1809.  
  1810.   If DoIt <> 0 then
  1811.     begin
  1812.     If (xx <> Delta.X) or (yy <> Delta.Y) then ScrollTo (xx, yy);
  1813.     Command := 0;
  1814.     If (DoIt > 1) and RS then SetUpRecord;
  1815.     If (DoIt > 0) and FS then SetUpField;
  1816.     end;
  1817.  
  1818. end;
  1819.  
  1820.  
  1821. procedure TDmxEditor.ProcessEnter (var Event : TEvent);
  1822. var Cmd : word;
  1823.     TP  : TPoint;
  1824. begin
  1825.   If (CurrentField^.Next <> nil) then
  1826.     Event.KeyCode := kbCtrlRight
  1827.    else
  1828.     begin
  1829.     fillchar (TP, sizeof (TP), 0);
  1830.     Cmd := cmDMX_NextRow;
  1831.     ProcessCommand (Cmd, TP);
  1832.     ClearEvent (Event);
  1833.     end;
  1834. end;
  1835.  
  1836.  
  1837. procedure TDmxEditor.ProcessKey (var Event : TEvent);
  1838. var i,j,k : integer;
  1839.     inx   : integer;
  1840.     TC    : char;
  1841.     Go    : boolean;
  1842.     InsOn : boolean;
  1843.     Tabbing : boolean;
  1844.     A     : string [80];
  1845.     XY    : TPoint;
  1846.     DFld  : pDMXfieldrec;
  1847.  
  1848.   procedure QuitField (Command : word);
  1849.   begin
  1850.     ProcessCommand (Command, XY);
  1851.     Event.KeyCode := kbNoKey;
  1852.     ClearEvent (Event);
  1853.   end;
  1854.  
  1855.   function  HexByte (Number : byte)  : string;
  1856.   const bts  : array [0..15] of char = '0123456789ABCDEF';
  1857.   begin
  1858.     HexByte := bts [(Number shr 4) and $0F] + bts [Number and $0F]
  1859.   end;
  1860.  
  1861.   function  EffectField (HEX : boolean;  Min,Max : longint)  : boolean;
  1862.   var i,j    : integer;
  1863.       FirstChar : integer;
  1864.       b        : boolean;
  1865.       R        : real;
  1866.   begin
  1867.     b := FALSE;
  1868.     If not ((Event.CharCode in [^G,^H,^T,^Y,'.','-','_','0'..'9']) or
  1869.        (HEX and (upcase (Event.CharCode) in ['A'..'F'])))
  1870.        or  (CurrentField^.access and accReadOnly <> 0)
  1871.        or  (Locked)
  1872.      then
  1873.       begin
  1874.       WrongKeypressed (Event);
  1875.       end
  1876.      else
  1877.       If A <> '' then With CurrentField^ do
  1878.     begin
  1879.     If (upperlimit <> 0) and (Max > upperlimit) then Max := upperlimit;
  1880.     If (decimals > 0) then i := succ (truelen) else i := truelen;
  1881.     If not HEX and (length (A) > i) then
  1882.       begin
  1883.       A [0] := chr (i);
  1884.       fillchar (A [1], length (A), '0');
  1885.       If length (A) - decimals > 2 then
  1886.         fillchar (A [1], length (A) - decimals - 2, ' ');
  1887.       If decimals > 0 then A [length (A) - decimals] := '.';
  1888.       end;
  1889.     If typecode in ['A'..'Z'] then Min := 0;
  1890.     FirstChar := pos ('.', A);
  1891.     If FirstChar > 0 then Dec (FirstChar) else FirstChar := length (A);
  1892.     If CurPos < pred (FirstChar) then CurPos := pred (FirstChar);
  1893.     Case Event.CharCode of
  1894.       ^G,
  1895.       ^H  :
  1896.           begin
  1897.           If CurPos = pred (FirstChar) then
  1898.         begin
  1899.         If (FirstChar < length (A)) then
  1900.           fillchar (A [FirstChar + 2], length (A) - succ (FirstChar), '0');
  1901.         If FirstChar > 1 then
  1902.           begin
  1903.           Move (A [1], A [2], pred (FirstChar));
  1904.           If HEX then A [1] := '0' else A [1] := ' ';
  1905.           If A [FirstChar] = '-' then
  1906.             begin
  1907.             A [FirstChar] := '0';
  1908.             ShowFmt := ShowFmt - [shownegative];
  1909.             end;
  1910.           end
  1911.          else
  1912.           begin
  1913.           A [1] := '0';
  1914.           end;
  1915.         end
  1916.            else
  1917.         begin
  1918.         A [succ (CurPos)] := '0';
  1919.         Dec (CurPos);
  1920.         If CurPos = FirstChar then Dec (CurPos);
  1921.         end;
  1922.           b := FALSE;
  1923.           For i := 1 to length (A) do If A [i] > '0' then b := TRUE;
  1924.           If not b then ShowFmt := ShowFmt - [shownegative];
  1925.           b := TRUE;
  1926.               If (A [FirstChar] = ' ') then A [FirstChar] := '0';
  1927.           end;
  1928.       ^T  :
  1929.           begin
  1930.           b := FALSE;
  1931.           ZeroizeField (TRUE, CurrentField);
  1932.           ShowFmt := ShowFmt - [shownegative];
  1933.           CurPos  := pred (FirstChar);
  1934.           For i := 1 to length (A) do If A [i] >= '0' then A [i] := '0';
  1935.           end;
  1936.       ^Y  :
  1937.           begin
  1938.           b := FALSE;
  1939.           ZeroizeRecord;
  1940.           ShowFmt := ShowFmt - [shownegative];
  1941.           CurPos  := pred (FirstChar);
  1942.           For i := 1 to length (A) do If A [i] >= '0' then A [i] := '0';
  1943.           end;
  1944.       '.' :
  1945.           begin
  1946.           If FirstChar < length (A) then
  1947.         begin
  1948.         CurPos := FirstChar;
  1949.         fillchar (A [FirstChar + 2], length (A) - succ (FirstChar), '0');
  1950.         b := TRUE;
  1951.         end
  1952.            else WrongKeypressed (Event);
  1953.           end;
  1954.       '-','_' :
  1955.           begin
  1956.           If (Min <> 0) and (A [1] = ' ') and
  1957.          (FirstChar > 1) and (pos ('-', A) = 0) then
  1958.         begin
  1959.         i := pred (FirstChar);
  1960.         ShowFmt := ShowFmt + [shownegative];
  1961.         While (A [i] <> ' ') do Dec (i);
  1962.         A [i] := '-';
  1963.         b := TRUE;
  1964.         end
  1965.            else WrongKeypressed (Event);
  1966.           end;
  1967.      else begin
  1968.           If (shownegative in ShowFmt) and (pos ('-',A) = 0) then
  1969.         begin
  1970.         If A [1] = ' ' then
  1971.           begin
  1972.           i := FirstChar;
  1973.           While (A [i] <> ' ') do Dec (i);
  1974.           If i <> 0 then A [i] := '-';
  1975.           end;
  1976.         end;
  1977.           If CurPos = pred (FirstChar) then
  1978.         begin
  1979.         If A [1] in [' ','0'] then
  1980.           begin
  1981.           If (FirstChar > 1) and not ((A [FirstChar] = '0') and (A [pred (FirstChar)] in ['-',' ']))
  1982.            then Move (A [2], A [1], pred (FirstChar));
  1983.           A [FirstChar] := Event.CharCode;
  1984.           b := TRUE;
  1985.           end;
  1986.         end
  1987.            else
  1988.         begin
  1989.         A [succ (CurPos) + 1] := Event.CharCode;
  1990.         If pred (length (A)) > CurPos then Inc (CurPos);
  1991.         b := TRUE;
  1992.         end;
  1993.           If (Max > 0) then
  1994.         begin
  1995.         Val (A, R, i);
  1996.         If (i <> 0) or (R > Max) or (R < Min) then b := FALSE;
  1997.         end
  1998.            else
  1999.         begin
  2000.         If (TC = fldCHARVAL) and parenthesis and (A [1] > '-') then b := FALSE;
  2001.         end;
  2002.           If not b then WrongKeypressed (Event);
  2003.           end;
  2004.       end;
  2005.     end;
  2006.     If b then
  2007.       begin
  2008.       ChangeMade;
  2009.       end;
  2010.     EffectField := b;
  2011.   end;
  2012.  
  2013. begin
  2014.   If (DataBlockSize < RecordSize) or (RecordSize <= 0) then Exit;
  2015.   If Locked or (CurrentField^.access and accReadOnly <> 0) then FirstKey := TRUE;
  2016.   Tabbing    := FALSE;
  2017.   InsOn        := not GetState (sfCursorIns);
  2018.   Go        := TRUE;
  2019.   If CurrentField = nil then CurrentField := DMXfield1;
  2020.   If (Event.What = evKeyDown) then
  2021.     begin
  2022.     If (Event.KeyCode = kbShiftEnter) then Exit;
  2023.     If (Event.KeyCode = kbShiftIns) then Event.CharCode := '0';
  2024.     If (Event.KeyCode = kbShiftDel) then Event.CharCode := '.';
  2025.     With CurrentField^ do
  2026.       begin
  2027.       TC := upcase (typecode);
  2028.       If (Event.KeyCode = kbEsc) or (Event.KeyCode = kbEnter) then
  2029.     begin
  2030.     QuitField (cmDMX_Enter);
  2031.     end
  2032.        else
  2033.     begin
  2034.     Event.KeyCode := CtrlToArrow (Event.KeyCode);
  2035.     If (FirstKey and InsOn) or
  2036.        (Locked or (CurrentField^.access and accReadOnly <> 0)) then
  2037.       begin
  2038.       If Event.KeyCode = kbRight then Event.KeyCode := kbCtrlRight
  2039.       else
  2040.       If Event.KeyCode = kbLeft  then Event.KeyCode := kbCtrlLeft;
  2041.       end
  2042.      else
  2043.       If (TC in [fldSTR,fldSTRNUM,fldCHAR,fldCHARNUM]) then
  2044.         begin
  2045.         If Event.KeyCode = kbRight then Event.CharCode := ^D else
  2046.         If Event.KeyCode = kbLeft  then Event.CharCode := ^S;
  2047.         end;
  2048.     If (Event.KeyCode = kbDel)  then Event.CharCode := ^G;
  2049.     If (Event.KeyCode = kbTab)  then
  2050.       begin
  2051.       Event.KeyCode  := kbCtrlRight;
  2052.       Tabbing := TRUE;
  2053.       end;
  2054.     If (Event.CharCode <> #0) then
  2055.       begin
  2056.       If FirstKey
  2057.         and (upcase (Event.CharCode) in ['-','.','0'..'9','A'..'F'])
  2058.         and (access and accReadOnly = 0)
  2059.        then
  2060.         begin
  2061.         If (TC in [fldBYTE, fldSHORTINT, fldWORD, fldINTEGER,
  2062.                fldLONGINT, fldCHARVAL, fldREALNUM, fldHEXVALUE])
  2063.          then ZeroizeField (FALSE, CurrentField);
  2064.         end;
  2065.       Case TC of
  2066.         fldSTR,
  2067.         fldSTRNUM,
  2068.         fldCHAR,
  2069.         fldCHARNUM :
  2070.           begin
  2071.           If typecode < 'a' then Event.CharCode := upcase (Event.CharCode);
  2072.           If ((TC in [fldSTRNUM, fldCHARNUM]) and
  2073.          not (Event.CharCode in [#0..' ', '0'..'9'])) or Locked
  2074.          or  (access and accReadOnly <> 0) then
  2075.         begin
  2076.         WrongKeypressed (Event);
  2077.         Go  := FALSE;
  2078.         end
  2079.            else
  2080.         begin
  2081.         If TC in [fldSTR, fldSTRNUM] then inx := 1 else inx := 0;
  2082.         Case Event.CharCode of
  2083.           ^G,    { kbDel }
  2084.           ^H  :  { kbBack }
  2085.             begin
  2086.             If Event.CharCode = ^H then
  2087.               begin
  2088.               If CurPos = 0 then Go := FALSE else Dec (CurPos);
  2089.               end;
  2090.             If Go then
  2091.               begin
  2092.               If (inx > 0) and (length (pstring (FieldData)^) <= CurPos) then Go := FALSE;
  2093.               If Go then
  2094.             begin
  2095.             ChangeMade;
  2096.             Move (pstring (FieldData)^ [CurPos + inx + 1],
  2097.                   pstring (FieldData)^ [CurPos + inx], fieldsize - CurPos - inx);
  2098.             pstring (FieldData)^ [pred (fieldsize)] := fillvalue;
  2099.             If (inx <> 0) and (pbyte (FieldData)^ > 0) then Dec (pstring (FieldData)^ [0]);
  2100.             end;
  2101.               end;
  2102.             end;
  2103.           ^D  :  { kbRight }
  2104.             If CurPos < fieldsize - inx - 1 then Inc (CurPos) else QuitField (cmDMX_Right);
  2105.           ^S  :  { kbLeft }
  2106.             begin
  2107.             If (CurPos > 0) then Dec (CurPos) else QuitField (cmDMX_Left);
  2108.             end;
  2109.           ^T  :  { clear field }
  2110.             begin
  2111.             ZeroizeField (FALSE, CurrentField);
  2112.             CurPos := 0;
  2113.             end;
  2114.           ^Y  :  { clear record }
  2115.             begin
  2116.             ZeroizeRecord;
  2117.             CurPos := 0;
  2118.             end;
  2119.           ^A..^Z  :  { prevent ctrl-characters from being entered }
  2120.             begin
  2121.             end;
  2122.            else begin
  2123.             If inx = 0 then i := fieldsize else i := pbyte (FieldData)^;
  2124.             If InsOn then
  2125.               begin
  2126.               If (fieldsize = succ (inx)) then pstring (FieldData)^ [inx] := fillvalue;
  2127.               If (ord (pstring (FieldData)^ [pred (fieldsize)]) and $DF = 0)
  2128.               or
  2129.              ((inx = 1) and (length (pstring (FieldData)^) < pred (fieldsize)))
  2130.                then
  2131.             begin
  2132.             ChangeMade;
  2133.             If (inx <> 0) then
  2134.               begin
  2135.               If (CurPos > i) then
  2136.                 begin
  2137.                 fillchar (pstring (FieldData)^ [succ (i)],
  2138.                       CurPos - i, fillvalue);
  2139.                 pbyte (FieldData)^ := succ (CurPos);
  2140.                 end
  2141.                else
  2142.                 Inc (pbyte (FieldData)^);
  2143.               end;
  2144.             If succ (CurPos) + inx < fieldsize then
  2145.               Move (pstring (FieldData)^ [CurPos + inx],
  2146.                 pstring (FieldData)^ [CurPos + inx + 1],
  2147.                 fieldsize - CurPos - inx - 1);
  2148.             pstring (FieldData)^ [CurPos + inx] := Event.CharCode;
  2149.             end
  2150.                else
  2151.             begin
  2152.             WrongKeypressed (Event);
  2153.             Go := FALSE;
  2154.             end;
  2155.               end
  2156.              else
  2157.               begin
  2158.               ChangeMade;
  2159.               If (inx <> 0) and (CurPos >= i) then
  2160.             begin
  2161.             fillchar (pstring (FieldData)^ [succ (i)],
  2162.                   CurPos - i, fillvalue);
  2163.             pbyte (FieldData)^ := succ (CurPos);
  2164.             end;
  2165.               pstring (FieldData)^ [CurPos + inx] := Event.CharCode;
  2166.               end;
  2167.             If CurPos < fieldsize - inx - 1 then
  2168.               begin
  2169.               If Go then Inc (CurPos);
  2170.               end
  2171.              else QuitField (cmDMX_Right);
  2172.             end;
  2173.           end;  { case of CharCode }
  2174.         If (CurPos < FirstPos) then FirstPos := CurPos;
  2175.         end;
  2176.           end;
  2177.  
  2178.         fldCHARVAL :
  2179.           begin
  2180.           Move (FieldData^, A [1], fieldsize);
  2181.           A [0] := chr (fieldsize);
  2182.           j := 0;
  2183.           For i := 1 to fieldsize do
  2184.         begin
  2185.         If (ord (A [i]) and not $20 = 0) then A [i] := ' ' else
  2186.         If (A [i] in ['-', '.', '0'..'9']) then j := 1;
  2187.         end;
  2188.           If j = 0 then
  2189.         begin
  2190.         fillchar (A [1], fieldsize, '0');
  2191.         If fieldsize - decimals > 2 then fillchar (A [1], fieldsize - decimals - 2, ' ');
  2192.         If decimals > 0 then A [fieldsize - decimals] := '.';
  2193.         end;
  2194.           If EffectField (FALSE, -1, 0) then
  2195.         begin
  2196.         i := 1;
  2197.         While (i < length (A)) and (A [i] <= '.') do
  2198.           begin
  2199.           If (A [succ (i)] <> '.') then A [i] := CurrentField^.fillvalue;
  2200.           Inc (i);
  2201.           end;
  2202.         Move (A [1], FieldData^, fieldsize);
  2203.         end;
  2204.           end;
  2205.  
  2206.         fldBYTE :
  2207.           begin
  2208.           Str (pbyte (FieldData)^:truelen, A);
  2209.           If EffectField (FALSE, 0,255) then Val (A,pbyte (FieldData)^,i);
  2210.           end;
  2211.  
  2212.         fldSHORTINT :
  2213.           begin
  2214.           Str (pshortint (FieldData)^:truelen, A);
  2215.           If EffectField (FALSE, -128,127) then Val (A,pshortint (FieldData)^,i);
  2216.           end;
  2217.  
  2218.         fldWORD :
  2219.           begin
  2220.           Str (pword (FieldData)^:truelen, A);
  2221.           If EffectField (FALSE, 0,65535) then Val (A,pword (FieldData)^,i);
  2222.           end;
  2223.  
  2224.         fldINTEGER :
  2225.           begin
  2226.           Str (pinteger (FieldData)^:truelen, A);
  2227.           If EffectField (FALSE, -1 - MaxInt, MaxInt) then Val (A,pinteger (FieldData)^,i);
  2228.           end;
  2229.  
  2230.         fldLONGINT :
  2231.           begin
  2232.           Str (plongint (FieldData)^:truelen, A);
  2233.           If EffectField (FALSE, -1 - MaxLongInt, MaxLongInt) then
  2234.         Val (A,plongint (FieldData)^,i);
  2235.           end;
  2236.  
  2237.         fldREALNUM :
  2238.           begin
  2239.           If decimals > 0 then i := 1 else i := 0;
  2240.           Str (prealnum (FieldData)^:truelen + i:decimals, A);
  2241.           If EffectField (FALSE, -1, 0) then Val (A,prealnum (FieldData)^,i);
  2242.           end;
  2243.  
  2244.         fldBOOLEAN :
  2245.           begin
  2246.           If (access and accReadOnly <> 0) or Locked then
  2247.         begin
  2248.         WrongKeypressed (Event);
  2249.         end
  2250.            else
  2251.         begin
  2252.         Event.CharCode := upcase (Event.CharCode);
  2253.         If (Event.CharCode = showTRUE)  then Event.CharCode := '+' else
  2254.         If (Event.CharCode = showFALSE) then Event.CharCode := '-';
  2255.         Case Event.CharCode of
  2256.           ^T  : ZeroizeField (FALSE, CurrentField);
  2257.           ^Y  : ZeroizeRecord;
  2258.           'A'..'Z', 'a'..'z',
  2259.           '+','*'  :
  2260.             begin
  2261.             fillchar (pboolean (FieldData)^, fieldsize, TRUE);
  2262.             ChangeMade;
  2263.             QuitField (cmDMX_Enter);
  2264.             end;
  2265.           ^G, ^H,
  2266.           '-',' '  :
  2267.             begin
  2268.             fillchar (pboolean (FieldData)^, fieldsize, FALSE);
  2269.             ChangeMade;
  2270.             If not (Event.CharCode in [^G,^H]) then QuitField (cmDMX_Enter);
  2271.             end;
  2272.          else WrongKeypressed (Event);
  2273.           end;
  2274.         end;
  2275.           end;
  2276.  
  2277.         fldHEXVALUE :
  2278.           begin
  2279.           Event.CharCode := upcase (Event.CharCode);
  2280.           If Event.CharCode in [^G,^H,^T,^Y, '0'..'9', 'A'..'F'] then
  2281.         begin
  2282.         A  := '';
  2283.         For i := 1 to fieldsize do A := hexbyte (ord (pstring (FieldData)^ [pred (i)])) + A;
  2284.         If (length (A) > truelen) then Delete (A, 1,1);
  2285.         If EffectField (TRUE, 0, 0) then
  2286.           begin
  2287.           If odd (length (A)) then A [0] := '0' else Move (A [1], A [0], length (A));
  2288.           For i := 0 to pred (fieldsize) do
  2289.             begin
  2290.             j := ord (A [i shl 1]);
  2291.             k := ord (A [succ (i shl 1)]);
  2292.             If j > ord ('9') then Dec (j, 7);
  2293.             If k > ord ('9') then Dec (k, 7);
  2294.             pstring (FieldData)^ [pred (fieldsize) - i] := chr (((j and 15) shl 4) or (k and 15));
  2295.             end;
  2296.           end;
  2297.         end
  2298.            else
  2299.         begin
  2300.         WrongKeypressed (Event);
  2301.         end;
  2302.           end;
  2303.         end;
  2304.       end;
  2305.     If Event.What <> evNothing then FirstKey := FALSE;
  2306.     end;
  2307.       end;
  2308.     end;
  2309.   If (Event.What = evKeyDown) and (Event.CharCode <> #0) then
  2310.     begin
  2311.     DrawField (CurrentField);
  2312.     ClearEvent (Event);
  2313.     end
  2314.    else
  2315.     begin
  2316.     Go := TRUE;
  2317.     Case Event.ScanCode of
  2318.       hi (kbIns):    If InsOn then BlockCursor else NormalCursor;
  2319.       hi (kbCtrlEnd):    QuitField (cmDMX_ScreenBottom);
  2320.       hi (kbCtrlHome):    QuitField (cmDMX_ScreenTop);
  2321.       hi (kbCtrlLeft),
  2322.       hi (kbLeft):    QuitField (cmDMX_Left);
  2323.       hi (kbShiftTab):
  2324.       begin
  2325.       TScroller.HandleEvent (Event);
  2326.       If GetState (sfFocused) then QuitField (cmDMX_Left) else QuitField (cmDMX_Enter);
  2327.       end;
  2328.       hi (kbCtrlPgDn):    QuitField (cmDMX_Bottom);
  2329.       hi (kbCtrlPgUp):    QuitField (cmDMX_Top);
  2330.       hi (kbCtrlRight),
  2331.       hi (kbRight):    QuitField (cmDMX_Right);
  2332.       hi (kbEnd):    QuitField (cmDMX_End);
  2333.       hi (kbHome):    QuitField (cmDMX_Home);
  2334.       hi (kbPgDn):    QuitField (cmDMX_PgDn);
  2335.       hi (kbPgUp):    QuitField (cmDMX_PgUp);
  2336.       hi (kbUp):    QuitField (cmDMX_Up);
  2337.       hi (kbDown):    QuitField (cmDMX_Down);
  2338.      else        Go := FALSE;
  2339.       end;
  2340.     If Go then ClearEvent (Event);
  2341.     end;
  2342.  
  2343. end;
  2344.  
  2345.  
  2346.   { ══════════════════════════════════════════════════════════════════════ }
  2347.  
  2348.  
  2349. procedure RegisterDMX;
  2350. begin
  2351.   RegisterType (RDmxLabels);
  2352.   RegisterType (RDmxScroller);
  2353.   RegisterType (RDmxRecInd);
  2354.   RegisterType (RDmxEditor);
  2355. end;
  2356.  
  2357.  
  2358.   { ══════════════════════════════════════════════════════════════════════ }
  2359.  
  2360.  
  2361. End.
  2362.